home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hottest 6
/
Hottest 6 (1996)(PDSoft)[!].iso
/
utilities
/
iconian
/
sources
/
gaugeimage.e
< prev
next >
Wrap
Text File
|
1978-11-24
|
8KB
|
259 lines
/* gaugeimage.class PublicDomain by Chad Randall */
OPT PREPROCESS
LIBRARY 'gaugeimage.class',1,1,'gaugeiclass 1.0 (18.8.95)' IS init_gaugeiclass,free_gaugeiclass
MODULE 'class/gaugeimage'
MODULE 'amigalib/boopsi'
MODULE 'exec/memory','exec/types'
MODULE 'graphics/gfxbase','graphics/scale','graphics/gfx','graphics/rastport',
'graphics/view','graphics/text'
MODULE 'intuition/classes','intuition/imageclass','intuition/cghooks','intuition/classusr',
'intuition/screens','intuition/intuition','intuition/gadgetclass'
MODULE 'tools/installhook'
MODULE 'utility','utility/tagitem'
MODULE 'gadtools','libraries/gadtools'
MODULE 'mod/gadgets'
MODULE 'mod/fonts'
MODULE 'mod/compare'
OBJECT gaugeidata
screen:PTR TO screen
bottom:LONG
top:LONG
curlevel:LONG
textfont:PTR TO textfont
textstyle:LONG
lastx:LONG
type:LONG
debug:LONG
lasttop:LONG
lastbottom:LONG
lastlevel:LONG
ENDOBJECT
PROC gaugeim_new(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO opset)
DEF data:PTR TO gaugeidata
DEF textstring=0
DEF dri=0:PTR TO drawinfo
DEF fti
data:=INST_DATA(cl, obj)
->data.debug:=Open('CON:',NEWFILE)
->stdout:=data.debug
data.screen:=GetTagData(GAUGEIA_SCREEN,NIL,msg.attrlist)
IF data.screen=0
RETURN -1
ELSE
data.bottom:=GetTagData(GAUGEIA_BOTTOM,NIL,msg.attrlist)
data.top:=GetTagData(GAUGEIA_TOP,100,msg.attrlist)
data.curlevel:=GetTagData(GAUGEIA_CURLEVEL,50,msg.attrlist)
data.type:=GetTagData(GAUGEIA_STYLE,NIL,msg.attrlist)
data.textfont:=GetTagData(GAUGEIA_TEXTFONT,NIL,msg.attrlist)
data.textstyle:=GetTagData(GAUGEIA_TEXTSTYLE,NIL,msg.attrlist)
ENDIF
ENDPROC
PROC gaugeim_dispose(cl:PTR TO iclass,obj:PTR TO object)
DEF data:PTR TO gaugeidata
data:=INST_DATA(cl, obj)
-> IF data.debug THEN Close(data.debug)
ENDPROC
PROC gaugeim_get(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO opget)
DEF data:PTR TO gaugeidata
DEF retval=TRUE
DEF switch
data:=INST_DATA(cl, obj)
switch:=msg.attrid
SELECT switch
CASE GAUGEIA_SCREEN;msg.storage:=data.screen
CASE GAUGEIA_BOTTOM;msg.storage:=data.bottom
CASE GAUGEIA_TOP;msg.storage:=data.top
CASE GAUGEIA_CURLEVEL;msg.storage:=data.curlevel
CASE GAUGEIA_STYLE;msg.storage:=data.type
CASE GAUGEIA_TEXTFONT;msg.storage:=data.textfont
CASE GAUGEIA_TEXTSTYLE;msg.storage:=data.textstyle
DEFAULT;retval:=doSuperMethodA(cl,obj,msg)
ENDSELECT
ENDPROC retval
PROC gaugeim_set(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO opset)
DEF data:PTR TO gaugeidata
DEF ti:PTR TO tagitem
DEF tstate:PTR TO tagitem
DEF switch
DEF update=FALSE
tstate:=msg.attrlist
data:=INST_DATA(cl, obj)
WHILE (ti:=NextTagItem({tstate}))
switch:=ti.tag
SELECT switch
CASE GAUGEIA_BOTTOM;data.bottom:=ti.data
CASE GAUGEIA_TOP;data.top:=ti.data
CASE GAUGEIA_CURLEVEL;data.curlevel:=ti.data
CASE GAUGEIA_STYLE;data.type:=ti.data
CASE GAUGEIA_TEXTFONT;data.textfont:=ti.data
CASE GAUGEIA_TEXTSTYLE;data.textstyle:=ti.data
ENDSELECT
ENDWHILE
ENDPROC
PROC gaugeim_draw(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO impdraw)
DEF data:PTR TO gaugeidata
DEF left,top,width,height
DEF switch
DEF bsa:PTR TO bitscaleargs
DEF temp_rp:PTR TO rastport
DEF visual
DEF drawinfo:PTR TO drawinfo
DEF newx
DEF w,h,i
DEF quant,max,bottom,textfont
DEF string
DEF drawtext=TRUE,drawlevel=TRUE
data:=INST_DATA(cl, obj)
switch:=msg.state
SELECT switch
CASE IDS_SELECTED;drawtext:=FALSE
CASE IDS_INACTIVENORMAL;drawlevel:=FALSE
ENDSELECT
IF data.screen
visual:=GetVisualInfoA(data.screen,NIL)
drawinfo:=msg.drinfo
IF drawinfo=0 THEN drawinfo:=GetScreenDrawInfo(data.screen)
GetAttr(IA_LEFT,obj,{left})
GetAttr(IA_TOP,obj,{top})
left:=left+msg.offsetx
top:=top+msg.offsety
IF (msg.methodid=IM_DRAWFRAME)
width:=msg.dimensionswidth
height:=msg.dimensionsheight
ELSE
GetAttr(IA_WIDTH,obj,{width})
GetAttr(IA_HEIGHT,obj,{height})
ENDIF
GetAttr(IA_DATA,obj,{string})
bottom:=data.bottom
max:=data.top
quant:=data.curlevel
IF ((max-bottom)>0)
newx:=(((width-7)*100)/(10000/(bigger((quant*100/(max)),1))))
IF ((newx<data.lastx) OR (data.top<>data.lasttop) OR (data.bottom<>data.lastbottom) OR (data.curlevel<data.lastlevel))
drawbevelbox(visual,msg.rport,left,top,width,height,1,TRUE,0)
data.lastx:=0
ENDIF
IF data.lastx=-1 THEN data.lastx:=0
SetDrMd(msg.rport,RP_JAM2)
SetAPen(msg.rport,drawinfo.pens[FILLPEN])
IF (drawlevel)
RectFill(msg.rport,left+data.lastx+3,top+2,left+newx+3,top+height-3)
IF data.type=GAUGETYPE_FANCY
qwikbox(visual,msg.rport,left,top,width,height,2,1,4)
qwikbox(visual,msg.rport,left,top,width,height,4,1,3)
qwikbox(visual,msg.rport,left,top,width,height,4,3,3)
qwikbox(visual,msg.rport,left,top,width,height,8,1,2)
qwikbox(visual,msg.rport,left,top,width,height,8,3,2)
qwikbox(visual,msg.rport,left,top,width,height,8,5,2)
qwikbox(visual,msg.rport,left,top,width,height,8,7,2)
ENDIF
ENDIF
ENDIF
IF (drawtext)
IF (string)
IF (drawlevel=FALSE)
drawbevelbox(visual,msg.rport,left,top,width,height,1,TRUE,0)
data.lastx:=-1
ENDIF
w,h:=fontsize2(msg.rport,string,data.textfont,data.textstyle)
SetFont(msg.rport,data.textfont)
SetDrMd(msg.rport,RP_JAM1)
Move(msg.rport,left+((width)/2)-(w/2),top+data.textfont.baseline+1)
SetAPen(msg.rport,drawinfo.pens[TEXTPEN])
Text(msg.rport,string,StrLen(string))
ENDIF
ENDIF
data.lastx:=newx
data.lasttop:=data.top
data.lastbottom:=data.bottom
data.lastlevel:=data.curlevel
IF msg.drinfo=0 THEN FreeScreenDrawInfo(data.screen,drawinfo)
FreeVisualInfo(visual)
ELSE
DisplayBeep(0)
ENDIF
ENDPROC
PROC gaugeim_hitframe(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO imphittest)
DEF left,top
GetAttr(IA_LEFT,obj,{left})
GetAttr(IA_TOP,obj,{top})
RETURN (msg.pointx>=left AND msg.pointy>=top AND msg.pointx<(left+msg.dimensionswidth) AND msg.pointy<(left+msg.dimensionsheight))
ENDPROC
PROC gaugeim_eraseframe(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO imperase)
DEF left,top
GetAttr(IA_LEFT,obj,{left})
GetAttr(IA_TOP,obj,{top})
left:=left+msg.offsetx
top:=top+msg.offsety
EraseRect(msg.rport,left,top,left+msg.dimensionswidth-1,top+msg.dimensionsheight-1)
ENDPROC
PROC gaugei_dispatcher(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO msg)
DEF retval=0
DEF switch
IF (utilitybase=0) THEN utilitybase:=OpenLibrary('utility.library',37)
IF (gadtoolsbase=0) THEN gadtoolsbase:=OpenLibrary('gadtools.library',37)
switch:=msg.methodid
SELECT switch
CASE OM_NEW
retval:=doSuperMethodA(cl,obj,msg)
IF retval THEN gaugeim_new(cl,retval,msg)
CASE OM_DISPOSE
gaugeim_dispose(cl,obj)
retval:=doSuperMethodA(cl,obj,msg)
CloseLibrary(utilitybase)
utilitybase:=0
CASE OM_GET;retval:=gaugeim_get(cl,obj,msg)
CASE OM_SET
retval:=1
doSuperMethodA(cl,obj,msg)
gaugeim_set(cl,obj,msg)
CASE IM_DRAW;gaugeim_draw(cl,obj,msg)
CASE IM_DRAWFRAME;gaugeim_draw(cl,obj,msg)
CASE IM_HITFRAME;retval:=gaugeim_hitframe(cl,obj,msg)
CASE IM_ERASEFRAME;gaugeim_eraseframe(cl,obj,msg)
DEFAULT;retval:=doSuperMethodA(cl,obj,msg)
ENDSELECT
ENDPROC retval
PROC init_gaugeiclass()
DEF cl:PTR TO iclass
IF cl:=MakeClass('gaugeiclass','imageclass',NIL,SIZEOF gaugeidata,0)
installhook(cl.dispatcher,{gaugei_dispatcher})
ENDIF
ENDPROC cl
PROC free_gaugeiclass(cl) IS FreeClass(cl)
PROC main() IS EMPTY
PROC qwikbox(visual,rast,x,y,w,h,div,mul,height)
drawbevelbox(visual,rast,x+((((w*100)/(div))*mul)/100),y+h-height-1,2,height,0)
ENDPROC
ver:
CHAR 0,0,'$VER: guageimage.class 1.0 (11.9.95)',0,0